home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / totsrc.zip / TOTIO2.INC < prev    next >
Text File  |  1991-02-11  |  9KB  |  366 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {File TOTIO2.INC}
  6.  
  7. {||||||||||||||||||||||||||||||||||||||||||||||||}
  8. {                                                }
  9. {     L i s t F i e l d O B J   M E T H O D S    }
  10. {                                                }
  11. {||||||||||||||||||||||||||||||||||||||||||||||||}
  12.  
  13. constructor ListIOOBJ.Init(X1,Y1,width,depth:byte;Title:string);
  14. {}
  15. begin
  16.    MultiLineIOOBJ.Init(X1,Y1,width,depth,Title);
  17.    vTopPick := 1;
  18.    vTotPicks := 0;
  19.    vActivePick := 1;
  20.    vListAssigned := false;
  21.    vScrollBarOn := false;
  22.    vActiveField := false;
  23. end; {ListIOOBJ.Init}
  24.  
  25. function ListIOOBJ.Select(K:word; X,Y:byte):TAction;
  26. {}
  27. var New: byte;
  28. begin
  29.    vScrollBarOn := (vTotPicks >= vRows);
  30.    vActiveField := true;
  31.    Display(HiStatus);
  32.    WriteLabel(HiStatus);
  33.    WriteMessage;
  34.    if (K = 513) or (K=523) then
  35.    begin
  36.       if vScrollBarOn and (X = vBorder.X2) then
  37.         {nothing for now}
  38.       else
  39.       begin
  40.          New := HitItem(Y);
  41.          if New > 0 then
  42.          begin
  43.             WriteItem(vActivePick,false);
  44.             vActivePick := New;
  45.             WriteItem(vActivePick,true);
  46.          end;
  47.       end;
  48.    end;
  49.    Select := none;
  50. end; {ListIOOBJ.Select}
  51.  
  52. procedure ListIOOBJ.WriteItem(Item:integer; Selected:boolean);
  53. {}
  54. var
  55.   Str: string;
  56.   High,Nor: byte;
  57.   Status: tStatus;
  58. begin
  59.    if vListAssigned then
  60.    begin
  61.       Str := GetString(pred(vTopPick)+Item);
  62.       if Selected then
  63.          Status := HiStatus
  64.       else
  65.          Status := Norm;
  66.       AssignColors(IOTOT^.vList,IOTOT^.vField,Status,High,Nor);
  67.       if (vActiveField = false) and Selected then
  68.          Nor := IOTOT^.ListCol(2);
  69.       Screen.WriteHi(vBorder.X1,vBorder.Y1+pred(Item),High,Nor,
  70.                      padleft(Str,vBorder.X2-vBorder.X1,' '));
  71.       if Selected then
  72.          Screen.GotoXY(vBorder.X1,vBorder.Y1+pred(Item));
  73.       if item = vActivePick then
  74.          ShowItemDetails(pred(vTopPick)+Item);
  75.    end;
  76. end; {ListIOOBJ.WriteItem}
  77.  
  78. procedure ListIOOBJ.DisplayAllPicks;
  79. {}
  80. var I : integer;
  81. begin
  82.    for I := 1 to vRows do
  83.        WriteItem(I,(I=vActivePick));
  84. end; {ListIOOBJ.DisplayAllPicks}
  85.  
  86. procedure ListIOOBJ.RefreshScrollBar;
  87. {}
  88. var High,Nor:byte;
  89. begin
  90.    AssignColors(IOTOT^.vList,IOTOT^.vField,Norm,High,Nor);
  91.    with vBorder do
  92.    if vScrollBarOn then
  93.       Screen.WriteVScrollBar(X2,Y1,Y2,Nor,pred(vTopPick+vActivePick),vTotPicks)
  94.    else
  95.       Screen.WriteVert(X2,Y1,Nor,replicate(succ(Y2-Y1),' '));
  96. end; {ListIOOBJ.RefreshScrollBar}
  97.  
  98. function ListIOOBJ.HitItem(Y:byte):byte;
  99. {returns the row number of the item falling on line Y, else returns 0}
  100. var
  101.   B: integer;
  102. begin
  103.     B := Y - pred(vBorder.Y1);
  104.     if (B > vRows) or (B < 0) or (B+pred(vTopPick)>vTotPicks) then
  105.        HitItem := 0
  106.     else
  107.        HitItem := B;
  108. end; {ListIOOBJ.HitItem}
  109.  
  110. procedure ListIOOBJ.ScrollJump(Y:byte);
  111. {}
  112. var
  113.   Tot: integer;
  114. begin
  115.    Tot := vBorder.Y2 - succ(vBorder.Y1);
  116.    Y := Y - vBorder.Y1;
  117.    if vTopPick + Y <= vTotPicks then
  118.    begin
  119.       if vTotPicks <= vRows then
  120.       begin
  121.          WriteItem(vActivePick,false);
  122.          vActivePick := (Y * vTotPicks) div Tot;
  123.          WriteItem(vActivePick,true);
  124.       end
  125.       else
  126.       begin
  127.          vTopPick := (Y * vTotPicks) div Tot;
  128.          vActivePick := 1;
  129.          DisplayAllPicks;
  130.       end;
  131.    end;
  132. end; {of proc ListIOOBJ.ScrollJump}
  133.  
  134. procedure ListIOOBJ.ScrollUp;
  135. {}
  136. begin
  137.    if vActivePick = 1 then
  138.    begin
  139.       if vTopPick > 1 then
  140.       begin
  141.          dec(vTopPick);
  142.          DisplayAllPicks;
  143.       end;
  144.    end
  145.    else
  146.    begin
  147.       WriteItem(vActivePick,false);
  148.       dec(vActivePick);
  149.       WriteItem(vActivePick,True);
  150.    end;
  151. end; {of proc ListIOOBJ.ScrollUp}
  152.  
  153. procedure ListIOOBJ.ScrollDown;
  154. {}
  155. begin
  156.    if pred(vTopPick) + vActivePick < vTotPicks then
  157.    begin
  158.       if vActivePick < vRows then
  159.       begin
  160.          WriteItem(vActivePick,false);
  161.          inc(vActivePick);
  162.          WriteItem(vActivePick,True);
  163.       end
  164.       else
  165.       begin
  166.          inc(vTopPick);
  167.          DisplayAllPicks;
  168.       end;
  169.    end;
  170. end; {of proc ListIOOBJ.ScrollDown}
  171.  
  172. procedure ListIOOBJ.ScrollPgUp;
  173. {}
  174. begin
  175.    if vTopPick > 1 then
  176.    begin
  177.       vTopPick := vTopPick - vRows;
  178.       if vTopPick < 1 then
  179.          vTopPick := 1;
  180.       DisplayAllPicks;
  181.    end
  182.    else if vActivePick <> 1 then
  183.    begin
  184.       WriteItem(vActivePick,false);
  185.       vActivePick := 1;
  186.       WriteItem(vActivePick,True);
  187.    end;
  188. end; {of proc ListIOOBJ.ScrollPgUp}
  189.  
  190. procedure ListIOOBJ.ScrollPgDn;
  191. {}
  192. begin
  193.    if pred(vTopPick + vRows) < vTotPicks then
  194.    begin
  195.       vTopPick := vTopPick + vRows;
  196.       vActivePick := 1;
  197.       DisplayAllPicks;
  198.    end
  199.    else if vActivePick + pred(vTopPick) < vTotPicks then
  200.    begin
  201.       WriteItem(vActivePick,false);
  202.       vActivePick := vTotPicks - pred(vTopPick);
  203.       WriteItem(vActivePick,True);
  204.    end;
  205. end; {of proc ListIOOBJ.ScrollPgDn}
  206.  
  207. procedure ListIOOBJ.ScrollHome;
  208. {}
  209. begin
  210.    if (vTopPick <> 1) or (vActivePick <> 1) then
  211.    begin
  212.       vTopPick := 1;
  213.       vActivePick := 1;
  214.       DisplayAllPicks;
  215.    end;
  216. end; {of proc ListIOOBJ.ScrollHome}
  217.  
  218. procedure ListIOOBJ.ScrollEnd;
  219. {}
  220. begin
  221.    if vTopPick + pred(vRows) >= vTotPicks then {last node on display}
  222.    begin
  223.       WriteItem(vActivePick,False);
  224.       vActivePick := succ(vTotPicks - vTopPick);
  225.       WriteItem(vActivePick,True);
  226.    end
  227.    else
  228.    begin
  229.      vTopPick := vTotPicks - pred(vRows);
  230.      vActivePick := vRows;
  231.      DisplayAllPicks;
  232.    end;
  233. end; {of proc ListIOOBJ.ScrollEnd}
  234.  
  235. procedure ListIOOBJ.Display(Status:tStatus);
  236. {}
  237. var
  238.   BorderCol : byte;
  239.   Style: byte;
  240.   I : integer;
  241. begin
  242.    MultiLineIOOBJ.Display(Status);
  243.    for I := 1 to vRows do
  244. (*
  245.       WriteItem(I,((I=vActivePick) and (Status=HiStatus)));
  246. *)
  247.       WriteItem(I,(I=vActivePick));
  248.  
  249.    if Status <> HiStatus then
  250.       vScrollBarOn := false;
  251.    RefreshScrollBar;
  252. end; {ListIOOBJ.Display}
  253.  
  254. procedure ListIOOBJ.AdjustMouseKey(var InKey: word;X,Y:byte);
  255. {}
  256. begin
  257.    if (X = vBorder.X2) and (vScrollBarOn) then {probably on scroll bar}
  258.    begin
  259.       if Y = vBorder.Y2 then
  260.          InKey := 611
  261.       else if Y = vBorder.Y1 then
  262.          InKey := 610
  263.       else if (Y > vBorder.Y1) and (Y < vBorder.Y2) then
  264.          Inkey := 614;
  265.    end;
  266. end; {ListIOOBJ.AdjustMouseKey}
  267.  
  268. function ListIOOBJ.TargetPick(X,Y:byte): longint;
  269. {}
  270. var Pick:integer;
  271. begin
  272.    Pick := 0;
  273.    if (X >= vBorder.X1) and (X <= vBorder.X2) then
  274.    begin
  275.       Pick := Y - pred(vBorder.Y1);
  276.       if (Pick > 0)
  277.       and (Pick <= vRows)
  278.       and (Pick + pred(vTopPick) <= vTotPicks) then
  279.          {OK}
  280.       else
  281.          Pick := 0;
  282.    end;
  283.    TargetPick := Pick;
  284. end; {ListIOOBJ.TargetPick}
  285.  
  286. procedure ListIOOBJ.MouseChoose(X,Y:byte);
  287. {}
  288. var Pick:integer;
  289. begin
  290.    Pick := TargetPick(X,Y);
  291.    if (Pick <> 0) and (Pick <> vActivePick) then
  292.    begin
  293.       WriteItem(vActivePick,false);
  294.       vActivePick  := Pick;
  295.       WriteItem(vActivePick,True);
  296.    end;
  297. end; {ListIOOBJ.MouseChoose}
  298.  
  299. function ListIOOBJ.SelectPick(InKey:word;X,Y:byte): tAction;
  300. {Semi-abstract}
  301. begin
  302.    SelectPick := NextField;
  303. end; {ListIOOBJ.SelectPick}
  304.  
  305. function ListIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;
  306. {}
  307. var
  308.   NextAction: tAction;
  309. begin
  310.    NextAction := none;
  311.    if InKey = 513 then
  312.       AdjustMousekey(Inkey,X,Y);
  313.    case InKey of
  314.       610,
  315.       328: ScrollUp;
  316.       32,
  317.       611,
  318.       336: ScrollDown;
  319.       513: MouseChoose(X,Y);
  320.       337: ScrollPgDn;
  321.       329: ScrollPgUp;
  322.       335: ScrollEnd;
  323.       327: ScrollHome;
  324.       614: begin  {vertical scroll bar}
  325.               if Y = succ(vBorder.Y1) then
  326.                  ScrollHome
  327.               else if Y = pred(vBorder.Y2) then
  328.                  ScrollEnd
  329.               else
  330.                  ScrollJump(Y); {vertical scroll bar}
  331.            end;
  332.       13,
  333.       523: NextAction := SelectPick(Inkey,X,Y);
  334.    end; {case}
  335.    RefreshScrollBar;
  336.    ProcessKey := NextAction;
  337. end; {ListIOOBJ.ProcessKey}
  338.  
  339. function ListIOOBJ.GetValue: integer;
  340. {}
  341. begin
  342.    GetValue := pred(vTopPick) + vActivePick;
  343. end; {ListIOOBJ.GetValue}
  344.  
  345. function ListIOOBJ.Suspend:boolean;
  346. {}
  347. begin
  348.    vScrollBarOn := false;
  349.    vActiveField := false;
  350.    Suspend := VisibleIOOBJ.Suspend;
  351. end; {ListIOOBJ.Suspend}
  352.  
  353. procedure ListIOOBJ.ShowItemDetails(HiPick: integer);
  354. {abstract}
  355. begin end;
  356. function ListIOOBJ.GetString(Pick:integer): string;
  357. {abstract}
  358. begin end;
  359.  
  360. destructor ListIOOBJ.Done;
  361. {}
  362. begin
  363.    MultiLineIOOBJ.Done;
  364. end; {ListIOOBJ.Done}
  365.  
  366.